home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
KF_CODER.ZIP
/
JFC.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1995-09-08
|
17KB
|
719 lines
program Szyfrator;
uses Dos, Crt;
var
p1 : string;
Header :record
HMet :string[7];
HSum :integer;
HRFile :string[12];
FNumber :integer;
end;
_File :record
FName :NameStr;
FExt :ExtStr;
FSize :longint;
FPos :longint;
IsLast :boolean;
end;
procedure Help;
var
ch :char;
begin
writeln('');
writeln('');
writeln(' JFC Coder is an encoder/decoder program which encrypts files');
writeln(' using an original key based on entered keyword. The keyword itself');
writeln(' is NOT stored in the coded file, therefore the Coder can''t percept');
writeln(' whether one entered the right keyword or not. However, when a wrong');
writeln(' keyword is entered the key based on it is also wrong, so the files');
writeln(' which would be uncoded can''t be used and are as illegible as the coded ones.');
writeln('');
writeln('Basic commands (ver. 1.0):');
writeln('');
writeln('C(reate), syntax:');
writeln(' jfc.exe c yourfile.jfc *.*');
writeln(' Where yourfile.jfc is a name of a file containing coded files,');
writeln(' *.* is a mask describing files to be coded, i.e. *.exe, *.txt,');
writeln(' save.*, mytext.txt etc.');
writeln('');
writeln('E(xtract), syntax:');
writeln(' jfc.exe e yourfile.jfc');
writeln(' Where yourfile.jfc is a name of a .jfc file from which the Coder');
writeln(' should extract coded files.');
writeln('');
write('Press any key to continue...');
ch:=readkey;
GotoXy(1,25);
writeln('L(ist), syntax: ');
writeln(' jfc.exe l yourfile.jfc');
writeln(' Where yourfile.jfc is a name of a .jfc file which you want to list');
writeln('');
writeln('Comments:');
writeln(' -- you don''t have to add .jfc extension - it''ll be added automagically.');
writeln(' -- try coding a text file and then extracting it with a wrong keyword to');
writeln(' see what would happen.');
writeln('');
halt;
end;
procedure CreateIt;
label 1,2,3,4,5;
var
a,FNumber,b :integer;
cf,df,ef :file;
i :longint;
P,P2,S,X :PathStr;
D,curd,DIRKA :DirStr;
N :NameStr;
E :ExtStr;
SR :SearchRec;
K1 :string[10];
CKey :array[1..10] of byte;
T,cr :char;
EndLoop,jfc :boolean;
copyb :array[1..10000] of byte;
begin
Header.HSum:=0;
if (paramstr(2)='') then
begin
writeln('');
writeln('ERROR#01: Required parameter missing');
writeln('');
Help;
end;
P:=paramstr(2);
X:=paramstr(3);
FSplit(P,D,N,E);
GetDir(0,curd);
E:='.JFC';
D:=Curd;
P:=N+E;
FSplit(X,D,N,E);
GetDir(0,curd);
S:=FSearch(D+P,curd);
if S<>'' then
begin
writeln('');
writeln('ERROR#02: File already exists');
gotoxy(15,wherey);
write('Overwrite?[Y,N] ');
readln(cr);
if Upcase(cr)='Y' then
begin
gotoxy(15,wherey-1); write(' ');
gotoxy(15,wherey);
end
else
begin
halt;
end;
end;
assign(cf,P);
{$I-} rewrite(cf,1); {$I-}
if (IOResult<>0) then
begin
writeln('');
writeln('ERROR#03: Unrecognized I/O error');
writeln('');
halt;
end;
1:
for i:=1 to 10 do K1[i]:=chr(0);
writeln('');
write('Enter code keyword (up to 10 chars): ');
readln(K1);
Header.Hsum:=0;
for i:=1 to 10 do Header.HSum:=Header.HSum+ord(K1[i]);
Header.HMet:='JFCoded';
for i:=1 to length(Header.HRFile) do begin Header.HRFile[i]:=UpCase(Header.HRFile[i]); end;
for i:=1 to 12 do P[i]:=Upcase(P[i]);
writeln('');
write('JFC name is '); HighVideo; write(P); LowVideo; writeln('.');
write('Keyword is ''');
HighVideo;
write(K1);
LowVideo;
writeln('''.');
2: write('Is this correct? [Y,N] ');
T:=readkey;
if (UpCase(T)<>'Y') and (Upcase(T)<>'N') then begin writeln(''); writeln('Enter [Y]es or [N]o'); goto 2; end
else writeln('');
if (UpCase(T)='N') then goto 1;
Blockwrite(cf,Header,SizeOf(Header));
for i:=1 to 10 do begin CKey[i]:=0; end;
for i:=1 to Length(K1) do
begin
if ord(K1[i])/1=int(ord(K1[i])/1) then Ckey[i]:=1;
if ord(K1[i])/2=int(ord(K1[i])/2) then Ckey[i]:=2;
if ord(K1[i])/3=int(ord(K1[i])/3) then Ckey[i]:=3;
if ord(K1[i])/4=int(ord(K1[i])/4) then Ckey[i]:=4;
if ord(K1[i])/5=int(ord(K1[i])/5) then Ckey[i]:=5;
if ord(K1[i])/6=int(ord(K1[i])/6) then Ckey[i]:=6;
if ord(K1[i])/7=int(ord(K1[i])/7) then Ckey[i]:=7;
if ord(K1[i])/8=int(ord(K1[i])/8) then Ckey[i]:=8;
if ord(K1[i])/9=int(ord(K1[i])/9) then Ckey[i]:=9;
if ord(K1[i])/10=int(ord(K1[i])/10) then Ckey[i]:=10;
if ord(K1[i])/11=int(ord(K1[i])/11) then Ckey[i]:=11;
if ord(K1[i])/12=int(ord(K1[i])/12) then Ckey[i]:=12;
if ord(K1[i])/13=int(ord(K1[i])/13) then Ckey[i]:=13;
if ord(K1[i])/14=int(ord(K1[i])/14) then Ckey[i]:=14;
if ord(K1[i])/15=int(ord(K1[i])/15) then Ckey[i]:=15;
end;
if CKey[10]=0 then
begin
for i:=Length(K1)+1 to 10 do
begin
CKey[i]:=CKey[i-Length(K1)];
end;
end;
{$I-} FindFirst(paramstr(3),Archive,SR); {$I+}
if doserror<>0 then
begin
writeln('');
writeln('ERROR#04: File not found!');
writeln('');
erase(cf);
halt;
end;
FSplit(SR.Name,DIRKA,_File.FName,_File.FExt);
if SR.Name=P then goto 4;
for i:=1 to Length(_File.FName) do
begin
_File.FName[i]:=chr(Ord(_File.FName[i]) xor CKey[i]);
end;
for i:=2 to Length(_File.FExt) do
begin
_File.FExt[i]:=chr(Ord(_File.FExt[i]) xor CKey[i]);
end;
_File.FExt[1]:='.';
Assign(df,D+SR.Name);
reset(df,1);
_File.FSize:=FileSize(df);
close(df);
4: Endloop:=false;
jfc:=false;
writeln('');
writeln('');
repeat
5: FindNext(SR);
FSplit(SR.Name,DIRKA,N,E);
if SR.Name=P then begin Sr.Name:='';jfc:=true; goto 5; end;
if doserror=18 then
begin
_File.IsLast:=true;
Blockwrite(cf,_File,SizeOf(_File));
jfc:=false;
EndLoop:=true;
end else begin
_File.IsLast:=false;
if jfc=false then Blockwrite(cf,_File,SizeOf(_File));
jfc:=false;
end;
_File.FName:=N;
_File.FExt:=E;
for i:=1 to Length(_File.FName) do
begin
_File.FName[i]:=chr(Ord(_File.FName[i]) xor CKey[i]);
end;
for i:=2 to Length(_File.FExt) do
begin
_File.FExt[i]:=chr(Ord(_File.FExt[i]) xor CKey[i]);
end;
_File.FExt[1]:='.';
If (sr.NAME<>'') then Assign(df,D+SR.Name);
reset(df,1);
_File.FSize:=FileSize(df);
close(df);
until EndLoop=true;
FNumber:=0;
repeat
i:=SizeOf(Header)+FNumber*SizeOf(_File);
seek(cf,i);
Blockread(cf,_File,SizeOf(_File));
{Decoding}
for i:=1 to Length(_File.FName) do
begin
_File.FName[i]:=chr(Ord(_File.FName[i]) xor CKey[i]);
end;
for i:=2 to Length(_File.FExt) do
begin
_File.FExt[i]:=chr(Ord(_File.FExt[i]) xor CKey[i]);
end;
{opening input file}
Assign(df,D+_File.FName+_File.FExt);
reset(df,1);
write(_File.FName+_File.FExt);
i:=FileSize(cf);
seek(cf,i);
a:=1;
for i:=1 to _File.FSize div 10000 do
begin
gotoxy(17,WhereY); write(i,'0kb');
Blockread(df,copyb,SizeOf(copyb));
a:=1;
for b:=1 to 10000 do
begin
copyb[b]:=copyb[b] xor CKey[a];
a:=a+1;
if a=11 then a:=1;
end;
Blockwrite(cf,copyb,SizeOf(copyb));
end;
if (_File.FSize mod 10000) <> 0 then
begin
Blockread(df,copyb,_File.FSize mod 10000);
a:=1;
for b:=1 to _File.FSize mod 10000 do
begin
copyb[b]:=copyb[b] xor CKey[a];
a:=a+1;
if a=11 then a:=1;
end;
Blockwrite(cf,copyb,_File.FSize mod 10000);
end;
gotoxy(17,WhereY); write(_File.FSize);
gotoxy(27,WHEREY); writeln(' bytes OK');
3:
FNumber:=FNumber+1;
close(df);
until _File.IsLast=true;
seek(cf,0);
Header.FNumber:=FNumber;
BlockWrite(cf,Header,SizeOf(Header));
writeln('');
writeln('');
write(P,' succesfully created. Don''t forget your keyword! (');
HighVideo; write(K1); LowVideo; writeln(')');
halt;
end;
procedure ListIt;
label 1;
var
cf,df :file;
checksum :integer;
K1 :string[10];
Ckey :array[1..10] of byte;
P,S :PathStr;
D,curd :DirStr;
N :NameStr;
E :ExtStr;
cr :char;
EndLoop :boolean;
a,c,b :integer;
AllSize,
skipto,i :longint;
begin
if (paramstr(2)='') then
begin
writeln('');
writeln('ERROR#01: Required parameter missing');
writeln('');
halt;
end;
P:=paramstr(2);
FSplit(P,D,N,E);
E:='.JFC';
P:=D+N+E;
Assign(cf,P);
GetDir(0,curd);
S:=FSearch(P,curd);
if S='' then
begin
writeln('');
writeln('ERROR#04: File not found!');
writeln('');
halt;
end;
{$I-} reset(cf,1); {$I+}
if (IOResult<>0) then
begin
writeln('');
writeln('ERROR#03: Unrecognized I/O error');
writeln('');
halt;
end;
Blockread(cf,Header,SizeOf(Header));
writeln('');
write('Enter code keyword for this file: ');
for i:=1 to 10 do K1[i]:=chr(0);
readln(K1);
writeln('');
checksum:=0;
for b:=1 to Length(K1) do
begin
checksum:=checksum+ord(K1[b]);
end;
if (checksum<>Header.HSum) then
begin
Highvideo;
write('WARNING!!!'); Lowvideo;
writeln(' (#',checksum,' #',Header.HSum,')');
writeln('You have probably entered an incorrect keyword.');
write('Proceed anyway? ');
readln(Cr);
writeln('');
if Upcase(Cr)='N' then halt;
end;
for i:=1 to 10 do begin CKey[i]:=0; end;
for i:=1 to Length(K1) do
begin
if ord(K1[i])/1=int(ord(K1[i])/1) then Ckey[i]:=1;
if ord(K1[i])/2=int(ord(K1[i])/2) then Ckey[i]:=2;
if ord(K1[i])/3=int(ord(K1[i])/3) then Ckey[i]:=3;
if ord(K1[i])/4=int(ord(K1[i])/4) then Ckey[i]:=4;
if ord(K1[i])/5=int(ord(K1[i])/5) then Ckey[i]:=5;
if ord(K1[i])/6=int(ord(K1[i])/6) then Ckey[i]:=6;
if ord(K1[i])/7=int(ord(K1[i])/7) then Ckey[i]:=7;
if ord(K1[i])/8=int(ord(K1[i])/8) then Ckey[i]:=8;
if ord(K1[i])/9=int(ord(K1[i])/9) then Ckey[i]:=9;
if ord(K1[i])/10=int(ord(K1[i])/10) then Ckey[i]:=10;
if ord(K1[i])/11=int(ord(K1[i])/11) then Ckey[i]:=11;
if ord(K1[i])/12=int(ord(K1[i])/12) then Ckey[i]:=12;
if ord(K1[i])/13=int(ord(K1[i])/13) then Ckey[i]:=13;
if ord(K1[i])/14=int(ord(K1[i])/14) then Ckey[i]:=14;
if ord(K1[i])/15=int(ord(K1[i])/15) then Ckey[i]:=15;
end;
if CKey[10]=0 then
begin
for i:=Length(K1)+1 to 10 do
begin
CKey[i]:=CKey[i-Length(K1)];
end;
end;
AllSize:=0;
writeln('Contents of: ',N,E);
writeln('');
for a:=1 to Header.FNumber do begin
i:=SizeOf(Header)+(a-1)*SizeOf(_File);
seek(cf,i);
Blockread(cf,_File,SizeOf(_File));
for i:=1 to Length(_File.FName) do
begin
_File.FName[i]:=chr(Ord(_File.FName[i]) xor CKey[i]);
end;
for i:=2 to Length(_File.FExt) do
begin
_File.FExt[i]:=chr(Ord(_File.FExt[i]) xor CKey[i]);
end;
write(_File.FName,_File.FExt);
GotoXy(20,WhereY);
writeln(_File.FSize);
skipto:=Sizeof(Header)+Header.FNumber*SizeOf(_File)+AllSize;
seek(cf,SkipTo);
1: Allsize:=allsize+_File.FSize;
end;
halt;
end;
procedure ExtractIt;
label 1;
var
cf,df :file;
checksum :integer;
NowX,NowY :byte;
K1 :string[10];
Ckey :array[1..10] of byte;
P,S :PathStr;
D,curd :DirStr;
N :NameStr;
E :ExtStr;
cr :char;
copyb :array[1..10000] of byte;
EndLoop :boolean;
a,c,b :integer;
AllSize,
skipto,i :longint;
begin
if (paramstr(2)='') then
begin
writeln('');
writeln('ERROR#01: Required parameter missing');
writeln('');
Halt;
end;
P:=paramstr(2);
FSplit(P,D,N,E);
E:='.JFC';
P:=D+N+E;
Assign(cf,P);
GetDir(0,curd);
S:=FSearch(P,curd);
if S='' then
begin
writeln('');
writeln('ERROR#04: File not found!');
writeln('');
halt;
end;
{$I-} reset(cf,1); {$I+}
if (IOResult<>0) then
begin
writeln('');
writeln('ERROR#03: Unrecognized I/O error');
writeln('');
halt;
end;
Blockread(cf,Header,SizeOf(Header));
writeln('');
write('Enter code keyword for this file: ');
NowX:=WhereX;
NowY:=WhereY;
writeln('');
writeln(''); Highvideo;
write('WARNING!!!'); Lowvideo;
writeln(' If you enter a wrong keyword, JFC Coder will probably');
writeln('report an I/O error. If not, don''t try to run a file which');
writeln('would be uncoded -- you''d be lucky if your computer wouldn''t crash!');
Gotoxy(NowX,Wherey-5);
for i:=1 to 10 do K1[i]:=chr(0);
readln(K1);
for i:=1 to 4*80 do begin write(' '); end;
gotoxy(NowX,Wherey-4);
writeln('');
writeln('');
checksum:=0;
for b:=1 to Length(K1) do
begin
checksum:=checksum+ord(K1[b]);
end;
if (checksum<>Header.HSum) then
begin
Highvideo;
write('WARNING!!!'); Lowvideo;
writeln(' (#',checksum,' #',Header.HSum,')');
writeln('You have probably entered an incorrect keyword.');
write('Proceed anyway? ');
readln(Cr);
writeln('');
if Upcase(Cr)='N' then halt;
end;
for i:=1 to 10 do begin CKey[i]:=0; end;
for i:=1 to Length(K1) do
begin
if ord(K1[i])/1=int(ord(K1[i])/1) then Ckey[i]:=1;
if ord(K1[i])/2=int(ord(K1[i])/2) then Ckey[i]:=2;
if ord(K1[i])/3=int(ord(K1[i])/3) then Ckey[i]:=3;
if ord(K1[i])/4=int(ord(K1[i])/4) then Ckey[i]:=4;
if ord(K1[i])/5=int(ord(K1[i])/5) then Ckey[i]:=5;
if ord(K1[i])/6=int(ord(K1[i])/6) then Ckey[i]:=6;
if ord(K1[i])/7=int(ord(K1[i])/7) then Ckey[i]:=7;
if ord(K1[i])/8=int(ord(K1[i])/8) then Ckey[i]:=8;
if ord(K1[i])/9=int(ord(K1[i])/9) then Ckey[i]:=9;
if ord(K1[i])/10=int(ord(K1[i])/10) then Ckey[i]:=10;
if ord(K1[i])/11=int(ord(K1[i])/11) then Ckey[i]:=11;
if ord(K1[i])/12=int(ord(K1[i])/12) then Ckey[i]:=12;
if ord(K1[i])/13=int(ord(K1[i])/13) then Ckey[i]:=13;
if ord(K1[i])/14=int(ord(K1[i])/14) then Ckey[i]:=14;
if ord(K1[i])/15=int(ord(K1[i])/15) then Ckey[i]:=15;
end;
if CKey[10]=0 then
begin
for i:=Length(K1)+1 to 10 do
begin
CKey[i]:=CKey[i-Length(K1)];
end;
end;
AllSize:=0;
for a:=1 to Header.FNumber do begin
i:=SizeOf(Header)+(a-1)*SizeOf(_File);
seek(cf,i);
Blockread(cf,_File,SizeOf(_File));
for i:=1 to Length(_File.FName) do
begin
_File.FName[i]:=chr(Ord(_File.FName[i]) xor CKey[i]);
end;
for i:=2 to Length(_File.FExt) do
begin
_File.FExt[i]:=chr(Ord(_File.FExt[i]) xor CKey[i]);
end;
write(_File.FName,_File.FExt);
skipto:=Sizeof(Header)+Header.FNumber*SizeOf(_File)+AllSize;
seek(cf,SkipTo);
Assign(df,_File.FName+_File.FExt);
GetDir(0,curd);
S:=FSearch(_File.FName+_File.FExt,curd);
if S<>'' then
begin
gotoxy(15,wherey);
write('Overwrite?[Y,N] ');
readln(cr);
if Upcase(cr)='Y' then
begin
gotoxy(15,wherey-1); write(' ');
gotoxy(15,wherey);
end
else
begin
gotoxy(15,wherey-1); writeln('Skipped ');
goto 1;
end;
end;
{$I-} rewrite(df,1); {$I+}
if (IOResult<>0) then
begin
writeln('');
writeln('');
writeln('ERROR#03: Unrecognized I/O error');
writeln('');
halt;
end;
for i:=1 to 10000 do copyb[i]:=0;
for i:=1 to _File.FSize div 10000 do
begin
Blockread(cf,copyb,SizeOf(copyb));
gotoxy(15,wherey); write(i,'0kb');
c:=1;
for b:=1 to 10000 do
begin
copyb[b]:=copyb[b] xor CKey[c];
c:=c+1;
if c=11 then c:=1;
end;
Blockwrite(df,copyb,SizeOf(copyb));
end;
if (_File.FSize mod 10000)<>0 then
begin
Blockread(cf,copyb,_File.FSize mod 10000);
c:=1;
for b:=1 to _File.FSize mod 10000 do
begin
copyb[b]:=copyb[b] xor CKey[c];
c:=c+1;
if c=11 then c:=1;
end;
Blockwrite(df,copyb,_File.FSize mod 10000);
end;
gotoxy(15,wherey); writeln(_File.FSize);
1: Allsize:=allsize+_File.FSize;
end;
writeln('');
for i:=1 to length(P) do P[i]:=UpCase(P[i]);
writeln(P,' succesfully uncoded.');
halt;
end;
begin
p1:=paramstr(1);
writeln(#10,#13,#10,#13,
'JFC Coder Version 1.0, written by Kuba Fast 1993-94.');
if (p1<>'?') and (p1<>'/?') then writeln('Use ''jfc /?'' for help.');
if (p1='C') or (p1='c') then CreateIt;
if (p1='L') or (p1='l') then ListIt;
if (p1='E') or (p1='e') then ExtractIt;
if (p1='?') or (p1='/?') or (p1='-?') then Help;
writeln('');
writeln('ERROR#01: Required parameter missing');
writeln('');
end.